home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / util1 / repack34.lha / repack.rexx < prev    next >
OS/2 REXX Batch file  |  1995-12-14  |  20KB  |  768 lines
  1. /*             Welcome, code dumper!
  2. LHA-LZX V1.0-2.0 by Mat Bettinson of the Plot Hatching Factory '95
  3. LHA-LZX V3.0 and above by Andrea Vallinotto.
  4.  
  5. $VER: LZX Repacker V 3.4, by Andrea Vallinotto (14.12.95)
  6. © 1995 Nathan Johnes Software lavatories :->
  7.  
  8. Since Jonathan Forbes' brilliant LZX came along and promptly blew LHA away,
  9. there's a need for a bulk converter. This is such a device.
  10.  
  11. You can execute this script with the following parameters: destination
  12. directory (any valid path name), temp directory (as above), efficiency
  13. (either 1, 2 or 3), keeping of old date and filenote updating ('on' or any
  14. other string for 'off'), and directory recursion (as BBS mode). If you
  15. wish, you can change the value of the LZX merging-group in the beginning of
  16. the program (see below!).
  17.  
  18. If you don't specify any of the above parameters, the script will ask you for
  19. the proper parameters, using nice Reqtools requesters.
  20.  
  21. BEWARE: the temp dir must be large enough to accommodate the largest extracted
  22. archive you're converting (including sub-archives, if present!).
  23.  
  24. You'll need: 
  25. in your search path: for lha and lzh archives either Lha, Lhx or LZX registered;
  26.              for tar archives either Tar, Gnutar or Detar,
  27.              and unzip, unarj, unrar, hpack, xarc, zoo, arc, gzip, LZX,
  28.              Delete, Setdate, Filenote and Which.
  29.     and in libs: rexxreqtools.library and reqtools.library .
  30.  
  31. Since this version, LZX version 1.20 or above is REQUIRED!
  32.  
  33. You can change the following value to suit you needs! It's the maximum group
  34. size that LZX can create. */
  35.  
  36. groupsize=2900
  37.  
  38. /* Don't modify nothing below this line: spaghetti code lies behind...
  39.         DON'T SAY YOU'VE NOT BEEN WARNED!! 
  40. (But what kind of code would you expect from an Italian, anyway ? :-)) ) */
  41.  
  42. options results
  43. options failat 9
  44. signal on break_c
  45. signal on halt
  46.  
  47. verstring='LZX Repacker version 3.4'
  48. parse var verstring jf utilname blah ver .
  49. titlestring=left(utilname,6) ver
  50. copyleft='by Andrea Vallinotto of Nowhere software'
  51. lstring="#?.(LZH|LHA|ZIP|ARJ|RAR|SHR|XAR|HPK|ARC|ZOO|PAK|TAR|GZ|Z|TGZ)"
  52. logname='t:Repack.log'
  53. anofile='s:repack.ano'
  54. cr='0a'x
  55. bold='1b'x'[1m'
  56. normal='1b'x'[0m'
  57. under='1b'x'[4m'
  58.  
  59. setuplib("rexxreqtools.library",0,-30,0)
  60. setuplib("rexxsupport.library",0,-30,0)
  61. parse source . . . scriptname . .
  62. if ~exists(scriptname) then signal badinstall
  63. call checklzx
  64.  
  65. parse arg instring
  66. if instring='?' then signal exofte
  67.  
  68. hmq=length(instring)-length(compress(instring,'"'))
  69. select
  70.     when hmq // 2 then signal baddata
  71.     when hmq=0 then do
  72.             parse var instring Dir root mode bbsmode rdm quiet .
  73.             signal init
  74.             end
  75.     otherwise nop
  76. end
  77.  
  78. a=0
  79. loop:
  80. instring=strip(instring,L)
  81. a=a+1
  82. select
  83.     when left(instring,1)='"' then do
  84.                 parse var instring '"' foo.a '"' instring
  85.                 signal loop
  86.                 end
  87.     when left(instring,1)="" then do
  88.                 foo.0=a-1
  89.                 signal complete
  90.                 end
  91.     otherwise         do
  92.                 parse var instring foo.a instring
  93.                 signal loop
  94.                 end
  95. end
  96. complete:
  97. if foo.0>0 then dir=foo.1
  98.         else dir=''
  99. if foo.0>1 then root=foo.2
  100.         else root=''
  101. if foo.0>2 then mode=foo.3
  102.         else mode=''
  103. if foo.0>3 then bbsmode=foo.4
  104.         else bbsmode=''
  105. if foo.0>4 then rdm=foo.5
  106.         else rdm=''
  107. if foo.0>5 then quiet=foo.6
  108.         else quiet=''
  109. init:
  110. select
  111.     when Dir = '' then DO
  112.             Dir = rtfilerequest('SYS:',,'Select directory to operate on',,'rtfi_flags = freqf_nofiles')
  113.             if dir = '' then signal ABORT
  114.             end
  115.     when ~exists(dir) then signal baddata
  116. otherwise nop
  117. end
  118. select
  119.     when root='' then DO
  120.             root = rtfilerequest('SYS:',,'Select temp dir',,'rtfi_flags = freqf_nofiles')
  121.             if root = '' then signal ABORT
  122.             end
  123.     when whatis(root) ~= 'DIR' then signal baddata
  124. otherwise nop
  125. end
  126.  
  127. effstring='_Fast|_Default|_More'
  128. maxeff=3
  129. if lzxreg then do
  130.         effstring=effstring'|M_aximum'
  131.         maxeff=9
  132.         end
  133.  
  134. if mode='' then Mode = rtezrequest('Choose LZX efficency',effstring,titlestring,'rtez_defaultresponse = 0',)
  135. select
  136.     when mode = 0 then mode = maxeff
  137.     when ~datatype(mode,N) then signal baddata
  138.     when (mode > maxeff | mode < 0) then signal baddata
  139. otherwise nop
  140. end
  141. bbsmode=upper(bbsmode)
  142. if bbsmode = '' then    do
  143.             if ~rtezrequest('Select date and comment updating','Set _New|Keep _old',titlestring,'rtez_defaultresponse = 1',)
  144.             then bbsmode='ON'
  145.             else bbsmode='OFF'
  146.         end
  147. rdm=upper(rdm)
  148. if rdm = '' then     do
  149.             if ~rtezrequest('Do you want to work in the subdirs too ?','_Yes|_No way!',titlestring,'rtez_defaultresponse = 0',)
  150.             then rdm='OFF'
  151.             else rdm='ON'
  152.         end
  153. if rdm='ON' then do     
  154.             address command "setenv tot 0"
  155.             address command "setenv tot2 0"
  156.         end    
  157. if quiet ='' then     do
  158.             say;say ' *** LHA-LZX repacker 1.0-2.0 by Mat Bettinson of the Plot Hatching Factory ***'
  159.             say '   *** 'verstring copyleft '***';say
  160.             end
  161.  
  162. oldstack=Pragma('S',50000)
  163. If right(root,1) ~= '/' & right(root,1) ~= ':' then root = root'/'
  164. bestia=whatis(dir)
  165. select
  166.     when bestia='' then signal baddata
  167.     when bestia='FILE' then sfm(dir)
  168.     otherwise sfm=0
  169. end
  170. call initlog('on directory' dir)
  171. If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
  172. if ~(length(root)-length(compress(root,':'))) then root=pragma(d)'/'root
  173. tempdir=root'RTD'
  174. mkdir(tempdir)
  175. if ~(length(dir)-length(compress(dir,':'))) then 
  176.                         if right(pragma(d),1)=':' then dir=pragma(d)dir
  177.                                     else dir=pragma(d)'/'dir
  178.                         else
  179.                         if dir=':' then dir=pragma(d)
  180. if bbsmode='ON' then do
  181.             Address COMMAND 'List 'quote(dir)' P 'lstring' DATES TO 'quote(root'lha-lzx_infos.temp')' FILES LFORMAT "%d %t %c"'
  182.             Call Open(infos,root'lha-lzx_infos.temp','R')
  183.             end
  184. if exists(quiet'recursive_LZX_repack.temp') then    Call Open(list,quiet'recursive_LZX_repack.temp','R')
  185.                             else do
  186.                             Address COMMAND "List "quote(Dir)" P "lstring" TO "quote(root'LHA-LZX.temp')" FILES LFORMAT %n"
  187.                             Call Open(list,root'LHA-LZX.temp','R')
  188.                             end
  189. Call Pragma('D',tempdir)
  190. call Writelogoptions
  191.  
  192. /* Mainloop */
  193. BSave = 0
  194. mainloop:
  195. call initano()
  196. DO forever
  197.     File = ReadLN(list)
  198.     IF EOF(list) then break
  199.     if bbsmode='ON' then do
  200.                 mix = ReadLN(infos)
  201.                 Datetime = subword(mix,1,2)
  202.                 Comment = quote(subword(mix,3))
  203.             end
  204.     NewFile = Left(File,lastpos('.',file))'LZX'
  205.     say 'Converting file: 'File
  206.     call Midcleanup()
  207.     Lhasize=Size(Dir||File)
  208.     signal on failure
  209.     WriteLog('Trying to extract' file)
  210.     arctype=extract(Dir||File)
  211.     signal off failure
  212.     if arctype="???" then do
  213.                 Say "Cannot determine arc type... skipping!"
  214.                 WriteLog("Couldn't determine arc type of" File '...skipped!')
  215.                 iterate
  216.                 end
  217.     WriteLog('File' file 'extracted OK. Repacking...')
  218.     Address COMMAND 'List PAT 'lstring' FILES ALL LFORMAT %p%n >'quote(root'recursive_LZX_repack.temp')
  219.     if size(root'recursive_LZX_repack.temp') ~= 0 then do
  220.                             WriteLog('Started recursion for file' file)
  221.                             Close(log)
  222.                             Address REXX scriptname quote(tempdir) quote(tempdir) mode bbsmode rdm quote(root)
  223.                             Call Open(log,logname,'A')
  224.                             end
  225.     Call fano()
  226.     old=pragma(d,tempdir)
  227.     signal on failure
  228.     if lzxreg then lzxmode=mode' -Qf'
  229.             else lzxmode=mode
  230.     Address COMMAND 'LZX -r -e -a -M'groupsize' -'lzxmode' -F a 'quote(Dir||NewFile) '#?'
  231.     signal off failure
  232.     call pragma(d,old)
  233.     Lzxsize=Size(Dir||Newfile)
  234.         Diff = Lhasize - Lzxsize
  235.     if Diff < 0 then DO
  236.         call Delete(Dir||NewFile)
  237.         say "The "arctype" archive was smaller than LZX... skipping!" ; say
  238.         WriteLog('Original file' file 'is smaller than LZX archive... skipping!')
  239.         Diff=0
  240.         end
  241.     else do
  242.         Address COMMAND 'Delete >NIL: 'quote(Dir||File) 'FORCE'
  243.         if bbsmode='ON' then do
  244.                     Address COMMAND 'Setdate >NIL: 'quote(Dir||NewFile) Datetime
  245.                     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) Comment
  246.                 end
  247.                 else     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) quote('Repacked by' utilname ver 'from' arctype 'archive; gained:' diff 'bytes!')
  248.         say '* 'Diff' bytes saved on this 'arctype' archive!' ; say
  249.         WriteLog('Converted' file 'to' newfile ', gained' Diff 'bytes')
  250.         end
  251.     BSave = BSave + Diff
  252. END
  253. if bsave=0 then Bsave="Sorry, no"
  254. select
  255.     when (quiet='' & rdm='OFF') then do
  256.                         bodytext='LZX Repacker has finished!'cr||Bsave' bytes saved in this dir.'
  257.                         call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  258.                         WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
  259.                     end
  260.     when (rdm='ON' & quiet='') | (rdm='OFF' & quiet='ON') then do
  261.                                     envsum(bsave)
  262.                                 end
  263.     otherwise    do
  264.             WriteLog('Finished file recursion')
  265.             end
  266. end
  267. Cleanup:
  268. Call PRAGMA('D',root)
  269. Call Close(list)
  270. Call Close(log)
  271. if bbsmode='ON' then Call Close(infos)
  272. Address COMMAND 'Delete >NIL: 'quote(tempdir)' ALL FORCE'
  273. call Delete(root'LHA-LZX.temp')
  274. call Delete(root'lha-lzx_infos.temp')
  275. call Delete(root'recursive_LZX_repack.temp')
  276. if rdm='ON' then signal multdirs
  277. call pragma('s',oldstack)
  278. EXIT 0
  279.  
  280. sfm:
  281. /* Single file mode... */
  282. parse arg sngfile
  283. sfm=1
  284. /* deve dare fn e dir */
  285. fn=substr(sngfile,max(lastpos(':', sngfile),lastpos('/', sngfile)) +1)
  286. dir=left(arg(1),max(lastpos(':',sngfile),lastpos('/',sngfile)))
  287. if ~(length(dir)-length(compress(dir,':'))) then /* Nel dir non ci sono i : */
  288.                         if right(pragma(d),1)=':' then dir=pragma(d)dir /* Se siamo in root, dir=root||dir */
  289.                                     else dir=pragma(d)'/'dir /* Se non siamo in root, dir=cwd||/||dir */ 
  290.                         else
  291.                         if dir=':' then dir=pragma(d) /* Ci sono i : ma solo quelli! (siamo in root)*/
  292. call initlog('on file' dir||fn)
  293. call writelogoptions
  294. open(fake,root'lha-lzx.temp',W)
  295. writeln(fake,fn)
  296. close(fake)
  297. tempdir=root'RTD'
  298. Mkdir(tempdir)
  299. if bbsmode='ON' then do
  300.             Address COMMAND 'List 'quote(Dir||fn)' DATES FILES LFORMAT "%d %t %c" >'quote(root'lha-lzx_infos.temp')
  301.             Call Open(infos,root'lha-lzx_infos.temp','R')
  302.             end
  303. Call Pragma('D',tempdir)
  304. Call Open(list,root'LHA-LZX.temp','R')
  305. Bsave=0
  306. signal mainloop
  307.  
  308. multdirs:
  309. pragma(d,dir)
  310. address command 'list >LZX-Repack.rdm DIRS LFORMAT "%p%s" ALL'
  311. if size('lZx-RePaCk.RdM') = 0 then do
  312.                     Say "There aren't any subdirs here, you JERK!"
  313.                     call delete('lzX-rEPacK.rDM')
  314.                     if bsave=0 then Bsave="Sorry, no"
  315.                     bodytext='LZX Repacker has finished!'cr||Bsave' bytes saved in this dir.'
  316.                     call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  317.                     Open(log,logname,'a')
  318.                     WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
  319.                     Call Close(log)
  320.                     exit
  321.                     end
  322. open(foo,'LzX-rEpAcK.rDm')
  323. do forever
  324.     ndtbp=readln(foo)
  325.     if eof(foo) then break
  326.     Close(log)
  327.     address REXX scriptname quote(ndtbp) quote(root) mode bbsmode 'OFF' 'ON'
  328. end
  329. close(foo)
  330. call delete('lzX-rEPacK.rDM')
  331. call pragma('s',oldstack)
  332. Say "Recursive mode finished!!"
  333. /* Gets total */
  334. open(tt,"env:tot");tot=readln(tt);close(tt)
  335. bodytext='LZX Repacker has finished!'cr||tot' bytes saved in directory recursion!'
  336. call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  337. Open(log,logname,A)
  338. Writelog(verstring 'finished directory recursion; total bytes saved:' tot)
  339. Writelog(cr)
  340. Call close(log)
  341. call delete('env:tot')
  342. call delete('env:tot2')
  343. exit 0
  344.  
  345.  
  346. midcleanup:
  347. Address COMMAND 'Delete >NIL: "'tempdir'/#?" ALL FORCE'
  348. return 1
  349.  
  350. badinstall:
  351. Say "Repack has been incorrectly installed! See the DOCS!"
  352. signal badexit
  353.  
  354. abort:
  355. Say 'Requester aborted!'
  356. signal badexit
  357.  
  358. baddata:
  359. Say 'One or more of the parameters supplied on the command line is bogus!!!'
  360.  
  361. badexit:
  362. Say '"Computer, end program!"'
  363. exit 5
  364.  
  365. extract:
  366. parse arg fullname
  367. select
  368.     when checklha(fullname) then arc=extlha(quote(fullname))
  369.     when checkzip(fullname) then arc=extzip(quote(fullname))
  370.     when checkarj(fullname) then arc=extarj(quote(fullname))
  371.     when checkrar(fullname) then arc=extrar(quote(fullname))
  372.     when checkshr(fullname) then arc=extshr(quote(fullname))
  373.     when checkxar(fullname) then arc=extxar(quote(fullname))
  374.     when checkarc(fullname) then arc=extarc(quote(fullname))
  375.     when checkzoo(fullname) then arc=extzoo(quote(fullname))
  376.     when checkpak(fullname) then arc=extpak(quote(fullname))
  377.     when checktgz(fullname) then arc=exttgz(quote(fullname))
  378.     when checktar(fullname) then arc=exttar(quote(fullname))
  379.     when checkgzip(fullname) then arc=extgzip(quote(fullname))
  380.     when checkhpack(fullname) then arc=exthpack(quote(fullname))
  381.         otherwise arc="???"
  382. end
  383. return arc
  384.  
  385. extlha:
  386. lxc='lha -a -F -M x'
  387. if (lzxreg & lha_h_l(arg(1))~='02'x) then lxc='lzx -a -F x'
  388.                             else if pathexists('lhx') then lxc='lhx -a -F -M x'
  389. Address COMMAND lxc arg(1) '#?'
  390. return "LHA"
  391.  
  392. extzip: 
  393. rctest=2
  394. options failat rctest
  395. Address COMMAND 'unzip -a -q 'arg(1)
  396. options failat 9
  397. return "ZIP"
  398.  
  399. extarj: 
  400. rctest=20
  401. options failat rctest
  402. Address COMMAND 'unarj x 'arg(1)
  403. options failat 9
  404. return "ARJ"
  405.  
  406. extrar: 
  407. Address COMMAND 'unrar x 'arg(1)
  408. return "RAR"
  409.  
  410. extshr:
  411. Address COMMAND 'shrink x 'arg(1) /* Unable to test if extr. failed! */
  412. return "Shrink"
  413.  
  414. extxar: 
  415. address command 'xarc -x 'arg(1) /* Unable to test if extr. failed! */
  416. return "XARC"
  417.  
  418. exthpack: 
  419. Address COMMAND 'hpack x -DA -R 'arg(1) /* Unable to test if extr. failed! */
  420. return "Hpack"
  421.  
  422. extarc:
  423. Address COMMAND 'arc e 'arg(1) /* Unable to test if extr. failed! */
  424. return "ARC"
  425.  
  426. extzoo:
  427. rctest=1
  428. options failat rctest
  429. Address COMMAND 'zoo eq/ 'arg(1)
  430. options failat 9
  431. return "ZOO"
  432.  
  433. exttgz:
  434. extgzip(arg(1))
  435. exttar(exitname)
  436. call delete(exitname)
  437. return "Tar-Gzipped"
  438.  
  439. extgzip:
  440. sss = Left(file,(lastpos('.',file)-1))
  441. exitname=tempdir'/'||(right(sss,(length(sss)-lastpos('/',sss))))
  442. rctest=1
  443. options failat rctest
  444. Address COMMAND 'gzip >'quote(exitname) '-cd 'arg(1)
  445. drop sss;options failat 9
  446. return "GZip"
  447.  
  448. exttar:
  449. rctest=3
  450. if pathexists('gnutar') then txc='gnutar -p -x -f'
  451.             else if pathexists('tar') then txc='tar -a -x -f'
  452.                             else do
  453.                                 txc='detar'
  454.                                 rctest=9
  455.                                 end
  456. options failat rctest
  457. Address command txc arg(1)
  458. options failat 9
  459. drop txc;return 'TAR'
  460.  
  461. extpak:
  462. Address COMMAND arg(1)
  463. return "PAK"
  464.  
  465. checklha: 
  466. call open(check,arg(1),r)
  467. seek(check,2,B)
  468. if readch(check,3)=="-lh" then     do 
  469.                 close(check)
  470.                 return 1
  471.                 end
  472. close(check) 
  473. return 0
  474.  
  475. lha_h_l:
  476. call open(headercheck,(strip(arg(1),B,'"')),r)
  477. seek(headercheck,20,B)
  478. val=readch(headercheck,1)
  479. close(headercheck)
  480. return val
  481.  
  482. checkzip: 
  483. call open(check,arg(1),r)
  484. if readch(check,2)=="PK" then do
  485.                 close(check)
  486.                 return 1
  487.                 end
  488. close(check)
  489. return 0
  490.  
  491. checkarj: 
  492. call open(check,arg(1),r)
  493. if readch(check,2)=="`ê" then do
  494.                 close(check)
  495.                 return 1
  496.                 end
  497. close(check)
  498. return 0
  499.  
  500. checkrar: 
  501. call open(check,arg(1),r)
  502. if readch(check,3)=="Rar" then do
  503.                 close(check)
  504.                 return 1
  505.                 end
  506. close(check)
  507. return 0
  508.  
  509. checkshr:
  510. return (checkxar(arg(1)) & (right(arg(1),(length(arg(1))-lastpos('.',arg(1))))='shr'))
  511.  
  512. checkxar: 
  513. call open(check,arg(1),r)
  514. if readch(check,4)=="FORM" & right(readch(check,8),4)=="CDAF" then do
  515.                 close(check)
  516.                 return 1
  517.                 end
  518. close(check) 
  519. return 0
  520.  
  521. checktgz:
  522. call open(check,arg(1),r)
  523. if ((upper(right(arg(1),3))='TGZ' | upper(right(arg(1),6))='TAR.GZ') & readch(check,3)=='1f8b08'x) then do
  524.                                 close(check)
  525.                                 return 1
  526.                                 end
  527. close(check)
  528. return 0
  529.  
  530.  
  531. checktar:
  532. open(ch,arg(1),r)
  533. call seek(ch,100) /* Moves up to the needed position*/
  534. /* Nooow... let's try with lots of triple checks including datatype() calls....*/
  535. select
  536.     when ~tlc(7) then signal notar
  537.     when ~tlc(7) then signal notar
  538.     when ~tlc(7) then signal notar
  539.     when ~tlc(30) then signal notar
  540. otherwise close(ch);return 1
  541. end
  542.  
  543. notar:
  544. close(ch);return 0
  545.  
  546. tlc:
  547. do arg(1)
  548. ts=readch(ch,1)
  549. if ~(ts==' ' | datatype(ts,N) ) then return 0
  550. end
  551. if readch(ch,1)=='0'x then return 1 /* The string is 0 terminated....*/
  552. return 0
  553.  
  554.  
  555. checkgzip: 
  556. call open(check,arg(1),r)
  557. if readch(check,3)=='1f8b08'x then do
  558.                 close(check)
  559.                 return 1
  560.                 end
  561. close(check)
  562. return 0
  563.  
  564. checkhpack: 
  565. call open(check,arg(1),r)
  566. if readch(check,4)=="HPAK" then do
  567.                 close(check)
  568.                 return 1
  569.                 end
  570. close(check)
  571. return 0
  572.  
  573. checkzoo: 
  574. call open(check,arg(1),r)
  575. if readch(check,4)=="ZOO " then do
  576.                 close(check)
  577.                 return 1
  578.                 end
  579. close(check)
  580. return 0
  581.  
  582. checkarc:
  583. call open(check,arg(1),r)
  584. if readch(check,2)=='1a08'x then do
  585.                 close(check)
  586.                 return 1
  587.                 end
  588. close(check)
  589. return 0
  590.  
  591. checkpak:
  592. call open(check,arg(1),r)
  593. call seek(check,248)
  594. if readch(check,11)=='dos.library' then do
  595.                 close(check)
  596.                 return 1
  597.                 end
  598. close(check)
  599. return 0
  600.  
  601. Size: procedure
  602. return word(statef(arg(1)),2)
  603.  
  604. fano:
  605. do id=1 to omit.0
  606. if length(omit.id)-length(compress(omit.id,'#?'))=0 then
  607.                             if ~exists(omit.id) then iterate
  608. address command 'delete >NIL:' quote(omit.id) 'FORCE'
  609. end
  610. do id=1 to add.0
  611. if ~exists(add.id) then iterate
  612. ADDRESS COMMAND 'Copy' add.id tempdir
  613. end
  614. return
  615.  
  616. initano:
  617. if ~exists(anofile) then do 
  618.                 add.0=0
  619.                 omit.0=0
  620.                 return
  621.             end
  622.  
  623. open(in,anofile,r)
  624. do until eof(in)
  625.     inline=readln(in)
  626.     if goodline(inline) then break
  627. end
  628. middle:
  629. select
  630.     when inline=='ADD:' then call addano
  631.     when inline=='OMIT:' then call omitano
  632. otherwise nop
  633. end
  634. if ~eof(in) then signal middle
  635. if ~datatype(add.0,'N') then add.0=0
  636. if ~datatype(omit.0,'N') then omit.0=0
  637. return
  638.  
  639. addano:
  640. count=0
  641. do forever
  642. inline=readln(in)
  643. if (eof(in) | inline=='OMIT:') then do
  644.                     add.0=count
  645.                     return
  646.                     end
  647. if goodline(inline) then do
  648.                 count=count+1;add.count=inline
  649.             end
  650. end
  651. return
  652.  
  653. omitano:
  654. count=0
  655. do forever
  656. inline=readln(in)
  657. if (eof(in) | inline=='ADD:') then do
  658.                     omit.0=count
  659.                     return
  660.                     end
  661. if goodline(inline) then do
  662.                     count=count+1;omit.count=inline
  663.             end
  664. end
  665. return
  666.  
  667.  
  668. goodline: procedure
  669. if (left(arg(1),1)==';' | arg(1)=='') then return 0
  670. return 1
  671.  
  672. failure:
  673. signal off failure
  674. if (RC=10 | RC=104 | RC=rctest) then do
  675.             Say bold"WARNING:"normal"Failed extracting "fullname" archive... skipping!"
  676.             midcleanup()
  677.             Writelog('Extraction error while unpacking' fullname 'archive... skipping!')
  678.             if sfm then exit(10)
  679.                 else signal mainloop
  680.             end
  681.     else do
  682.         Say bold"WARNING:"normal"Problem encountered while creating new LZX archive (not enough memory ?)."
  683.         Say "Keeping original "fullname" archive."
  684.         call delete(dir||Newfile)
  685.         midcleanup()
  686.         Writelog('Could not create new LZX archive; keeping' fullname 'archive.')
  687.         if sfm then exit(10)
  688.             else signal mainloop
  689.         end
  690.  
  691. setuplib: procedure
  692. parse arg library,v1,v2,v3
  693.  
  694. if(~show('l',library))then    do
  695.                 if(~addlib(library,v1,v2,v3))then    do
  696.                                     say "Could not open" library"! Aborting..."
  697.                                     exit 10
  698.                                     end
  699.                 end
  700. return 1
  701.  
  702. writelog:
  703. return WriteLN(log,date(e) time() arg(1))
  704.  
  705. initlog:
  706. om='W'
  707. if exists(logname) then om='A'
  708. open(log,logname,om)
  709. Writeln(log,cr)
  710. WriteLog('Started 'verstring arg(1))
  711. close(log)
  712. open(log,logname,'A')
  713. drop om;return
  714.  
  715. writelogoptions:
  716. return Writelog('Options: Efficency' mode', BBSmode:' bbsmode', directory recursion:' rdm)
  717.  
  718. pathexists: procedure
  719. address command 'which >nil:' arg(1)
  720. if rc=5 then return 0
  721. return 1
  722.  
  723. whatis: procedure
  724. return word(statef(arg(1)),1)
  725.  
  726. checklzx:
  727. address command 'which >NIL: lzx'
  728. if rc=5 then signal misslzx
  729. lzxreg=exists('l:lzx.keyfile')
  730. return
  731.  
  732. misslzx:
  733. say "LZX is not in installed (or not in your search path)!"
  734. exit(205)
  735.  
  736. mkdir: procedure
  737. return makedir(arg(1))
  738.  
  739. quote: procedure
  740. return '"'arg(1)'"'
  741.  
  742. halt:
  743. break_c:
  744. signal off break_c
  745. signal off halt
  746. signal off failure
  747. Say "Yo, man! You pressed Control-c! Stopping execution...."
  748. Writelog('User pressed Control-C, aborting....')
  749. call midcleanup()
  750. signal cleanup
  751.  
  752. exofte:
  753. /* Template! Template! Fate anche voi come me: io templo, template anche voi!*/
  754. Say bold||verstring||normal copyleft
  755. Say bold"Usage:"normal
  756. Say "[rx] "scriptname "DIR|FILE/K TEMPDIR/K MODE/N BBSMODE/S DIR.RECURSION/S"
  757. say
  758. say bold"Example:" normal
  759. say scriptname '"dh0:dir with many files" dh2:temp 3 ON OFF'
  760. Say
  761. say 'For more information,' under'RTFM!' normal
  762. say;exit
  763.  
  764. envsum: procedure
  765. address command "setenv tot2 `getenv tot`"
  766. address command 'eval >env:tot "`getenv tot2`" + 'arg(1)
  767. return 1
  768.